indiv smooths
William Norfolk
10/14/2020
Load all required libraries.
library(tidyverse)## Warning: package 'tidyverse' was built under R version 3.6.3## -- Attaching packages ---------------------------------------------------------------------------- tidyverse 1.3.0 --## v ggplot2 3.3.2 v purrr 0.3.4
## v tibble 3.0.3 v dplyr 1.0.0
## v tidyr 1.1.0 v stringr 1.4.0
## v readr 1.3.1 v forcats 0.5.0## Warning: package 'ggplot2' was built under R version 3.6.3## Warning: package 'tibble' was built under R version 3.6.3## Warning: package 'readr' was built under R version 3.6.3## Warning: package 'dplyr' was built under R version 3.6.3## Warning: package 'forcats' was built under R version 3.6.3## -- Conflicts ------------------------------------------------------------------------------- tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(plotly)## Warning: package 'plotly' was built under R version 3.6.3##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutlibrary(broom)## Warning: package 'broom' was built under R version 3.6.3Read in raw data from RDS.
raw_data <- readRDS("./n1_n2_cleaned_cases.rds")Make a few small modifications to names and data for visualizations.
final_data <- raw_data %>% mutate(log_copy_per_L = log10(mean_copy_num_L)) %>%
rename(Facility = wrf) %>%
mutate(Facility = recode(Facility,
"NO" = "WRF A",
"MI" = "WRF B",
"CC" = "WRF C"))Seperate the data by gene target to ease layering in the final plot
#make three data layers
only_positives <<- subset(final_data, (!is.na(final_data$Facility)))
only_n1 <- subset(only_positives, target == "N1")
only_n2 <- subset(only_positives, target == "N2")
only_background <<-final_data %>%
select(c(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke, cases_per_100000_clarke)) %>%
group_by(date) %>% summarise_if(is.numeric, mean)
#specify fun colors
background_color <- "#7570B3"
seven_day_ave_color <- "#E6AB02"
marker_colors <- c("N1" = '#1B9E77',"N2" ='#D95F02')#remove facilty C for now
#only_n1 <- only_n1[!(only_n1$Facility == "WRF C"),]
#only_n2 <- only_n2[!(only_n2$Facility == "WRF C"),]
#WRF C LOD values are coming up as NA, should be 0? #seperate n1 and n2 frames by site
#n1
wrf_a_only_n1 <- subset(only_n1, Facility == "WRF A")
wrf_b_only_n1 <- subset(only_n1, Facility == "WRF B")
wrf_c_only_n1 <- subset(only_n1, Facility == "WRF C")
#n2
wrf_a_only_n2 <- subset(only_n2, Facility == "WRF A")
wrf_b_only_n2 <- subset(only_n2, Facility == "WRF B")
wrf_c_only_n2 <- subset(only_n2, Facility == "WRF C")#build a function here to make smooth frames so we don't repeat everything in huge loops
#FOR INDIVIDUAL FIGURES ONLY
make_n1_smooth_frame <- function(df){
smooth_n1 <- df %>% select(-c(Facility)) %>%
group_by(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke, cases_per_100000_clarke) %>%
summarize(sum_copy_num_L = sum(mean_total_copies)) %>%
ungroup() %>%
mutate(log_sum_copies_L = log10(sum_copy_num_L)) %>%
mutate(target = "N1")
return(smooth_n1)
}
make_n2_smooth_frame <- function(df){
smooth_n1 <- df %>% select(-c(Facility)) %>%
group_by(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke, cases_per_100000_clarke) %>%
summarize(sum_copy_num_L = sum(mean_total_copies)) %>%
ungroup() %>%
mutate(log_sum_copies_L = log10(sum_copy_num_L)) %>%
mutate(target = "N2")
return(smooth_n1)
}
#run frames through the functions
wrfa_smooth_n1 <- make_n1_smooth_frame(wrf_a_only_n1)## `summarise()` regrouping output by 'date', 'cases_cum_clarke', 'new_cases_clarke', 'X7_day_ave_clarke' (override with `.groups` argument)wrfb_smooth_n1 <- make_n1_smooth_frame(wrf_b_only_n1)## `summarise()` regrouping output by 'date', 'cases_cum_clarke', 'new_cases_clarke', 'X7_day_ave_clarke' (override with `.groups` argument)wrfc_smooth_n1 <- make_n1_smooth_frame(wrf_c_only_n1)## `summarise()` regrouping output by 'date', 'cases_cum_clarke', 'new_cases_clarke', 'X7_day_ave_clarke' (override with `.groups` argument)wrfa_smooth_n2 <- make_n2_smooth_frame(wrf_a_only_n2)## `summarise()` regrouping output by 'date', 'cases_cum_clarke', 'new_cases_clarke', 'X7_day_ave_clarke' (override with `.groups` argument)wrfb_smooth_n2 <- make_n2_smooth_frame(wrf_b_only_n2)## `summarise()` regrouping output by 'date', 'cases_cum_clarke', 'new_cases_clarke', 'X7_day_ave_clarke' (override with `.groups` argument)wrfc_smooth_n2 <- make_n2_smooth_frame(wrf_c_only_n2)## `summarise()` regrouping output by 'date', 'cases_cum_clarke', 'new_cases_clarke', 'X7_day_ave_clarke' (override with `.groups` argument)#get max date
maxdate <- max(wrfa_smooth_n1$date)
mindate <- min(wrfa_smooth_n1$date)Build loess smoothing figures figures
#COMBINED FIGURE ONLY
#create smoothing data frames
#n1
smooth_n1 <- only_n1 %>% select(-c(Facility)) %>%
group_by(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke, cases_per_100000_clarke) %>%
summarize(sum_copy_num_L = sum(mean_total_copies)) %>%
ungroup() %>%
mutate(log_sum_copies_L = log10(sum_copy_num_L)) %>%
mutate(target = "N1")## `summarise()` regrouping output by 'date', 'cases_cum_clarke', 'new_cases_clarke', 'X7_day_ave_clarke' (override with `.groups` argument)#n2
smooth_n2 <- only_n2 %>% select(-c(Facility)) %>%
group_by(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke, cases_per_100000_clarke) %>%
summarize(sum_copy_num_L = sum(mean_total_copies)) %>%
ungroup() %>%
mutate(log_sum_copies_L = log10(sum_copy_num_L)) %>%
mutate(target = "N2")## `summarise()` regrouping output by 'date', 'cases_cum_clarke', 'new_cases_clarke', 'X7_day_ave_clarke' (override with `.groups` argument)This makes the individual plots
#**************************************WRF A PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#n1 extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_n1a <- ggplot(wrfa_smooth_n1, aes(x = date, y = log_sum_copies_L)) +
stat_smooth(aes(outfit=fit_n1a<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 142)## Warning: Ignoring unknown aesthetics: outfit#n2 extract
extract_n2a <- ggplot(wrfa_smooth_n2, aes(x = date, y = log_sum_copies_L)) +
stat_smooth(aes(outfit=fit_n2a<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 142)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#n1
extract_n1a## `geom_smooth()` using formula 'y ~ x'
fit_n1a## [1] 11.29089 11.33811 11.38478 11.43041 11.47447 11.51647 11.55589 11.59222
## [9] 11.62580 11.65746 11.68745 11.71599 11.74334 11.76974 11.79542 11.81939
## [17] 11.84071 11.85966 11.87650 11.89154 11.90505 11.91731 11.92860 11.93922
## [25] 11.94943 11.95953 11.96979 11.98050 11.99193 11.99748 11.99288 11.98194
## [33] 11.96849 11.95635 11.94932 11.95124 11.95473 11.95090 11.94124 11.92727
## [41] 11.91050 11.89245 11.87462 11.85852 11.84567 11.83757 11.83574 11.84169
## [49] 11.85692 11.88296 11.92063 11.96785 12.02171 12.07933 12.13780 12.19424
## [57] 12.24574 12.30171 12.37189 12.45388 12.54527 12.64367 12.74667 12.85188
## [65] 12.95688 13.05929 13.15670 13.24671 13.32692 13.39492 13.44832 13.49681
## [73] 13.55056 13.60790 13.66715 13.72663 13.78466 13.83959 13.88971 13.93338
## [81] 13.96889 13.99459 14.00880 14.00983 13.99602 13.95337 13.87710 13.77938
## [89] 13.67235 13.56817 13.47899 13.41697 13.36316 13.29245 13.20775 13.11196
## [97] 13.00800 12.89876 12.78715 12.67608 12.56846 12.46719 12.37517 12.29532
## [105] 12.23054 12.18373 12.15414 12.13652 12.12706 12.12195 12.11736 12.10949
## [113] 12.09451 12.07611 12.06049 12.04764 12.03753 12.03013 12.02543 12.02340
## [121] 12.02402 12.02726 12.03310 12.04151 12.05248 12.06598 12.08199 12.10105
## [129] 12.12352 12.14902 12.17721 12.20773 12.24021 12.27431 12.31008 12.34785
## [137] 12.38766 12.42959 12.47367 12.51996 12.56852 12.61940#n2
extract_n2a## `geom_smooth()` using formula 'y ~ x'
fit_n2a## [1] 10.82968 10.99734 11.16111 11.32037 11.47449 11.62282 11.76474 11.89961
## [9] 12.02783 12.15042 12.26766 12.37983 12.48724 12.59017 12.68890 12.78222
## [17] 12.86897 12.94951 13.02419 13.09337 13.15742 13.21668 13.27153 13.32231
## [25] 13.36939 13.41313 13.45388 13.49200 13.52786 13.55537 13.57049 13.57657
## [33] 13.57696 13.57504 13.57415 13.57765 13.57381 13.55064 13.51116 13.45837
## [41] 13.39528 13.32492 13.25028 13.17438 13.10023 13.03084 12.96922 12.91838
## [49] 12.88133 12.86109 12.84872 12.83445 12.82002 12.80718 12.79768 12.79327
## [57] 12.79569 12.81004 12.83875 12.87956 12.93021 12.98846 13.05206 13.11876
## [65] 13.18629 13.25242 13.31488 13.37143 13.41981 13.45778 13.48308 13.50448
## [73] 13.53130 13.56208 13.59536 13.62971 13.66365 13.69575 13.72454 13.74858
## [81] 13.76641 13.77658 13.77763 13.76812 13.74658 13.70096 13.62713 13.53558
## [89] 13.43681 13.34131 13.25956 13.20205 13.15359 13.09338 13.02351 12.94608
## [97] 12.86318 12.77690 12.68933 12.60257 12.51871 12.43984 12.36806 12.30546
## [105] 12.25413 12.21616 12.19971 12.20564 12.22517 12.24949 12.26980 12.27732
## [113] 12.26323 12.23691 12.21328 12.19190 12.17233 12.15414 12.13687 12.12009
## [121] 12.10335 12.08622 12.06825 12.04900 12.02802 12.00489 11.97915 11.95292
## [129] 11.92810 11.90394 11.87968 11.85457 11.82786 11.79878 11.76739 11.73434
## [137] 11.69981 11.66399 11.62704 11.58916 11.55052 11.51130#assign fits to a vector
n1_trenda <- fit_n1a
n2_trenda <- fit_n2a
#extract y min and max for each
limits_n1a <- ggplot_build(extract_n1a)$data## `geom_smooth()` using formula 'y ~ x'limits_n1a <- as.data.frame(limits_n1a)
n1_ymina <- limits_n1a$ymin
n1_ymaxa <- limits_n1a$ymax
limits_n2a <- ggplot_build(extract_n2a)$data## `geom_smooth()` using formula 'y ~ x'limits_n2a <- as.data.frame(limits_n2a)
n2_ymina <- limits_n2a$ymin
n2_ymaxa <- limits_n2a$ymax
#reassign dataframes (just to be safe)
work_n1a <- wrfa_smooth_n1
work_n2a<- wrfa_smooth_n1
#fill in missing dates to smooth fits
work_n1a <- work_n1a %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_n1a <- work_n1a$date
work_n2a <- work_n2a %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_n2a <- work_n2a$date
#create a new smooth dataframe to layer
smooth_frame_n1a <- data.frame(date_vec_n1a, n1_trenda, n1_ymina, n1_ymaxa)
smooth_frame_n2a <- data.frame(date_vec_n2a, n2_trenda, n2_ymina, n2_ymaxa)#WRF A
#plot smooth frames
p_wrf_a <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_n1a, y = ~n1_trenda,
data = smooth_frame_n1a,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n1a,
'</br> Median Log Copies: ', round(n1_trenda, digits = 2),
'</br> Target: N1'),
line = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_lines(x = ~date_vec_n2a, y = ~n2_trenda,
data = smooth_frame_n2a,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n2a,
'</br> Median Log Copies: ', round(n2_trenda, digits = 2),
'</br> Target: N2'),
line = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
plotly::add_ribbons(x ~date_vec_n1a, ymin = ~n1_ymina, ymax = ~n1_ymaxa,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n1a, #leaving in case we want to change
'</br> Max Log Copies: ', round(n1_ymaxa, digits = 2),
'</br> Min Log Copies: ', round(n1_ymina, digits = 2),
'</br> Target: N1'),
name = "",
line = list(color = '#1B9E77')) %>%
plotly::add_ribbons(x ~date_vec_n2a, ymin = ~n2_ymina, ymax = ~n2_ymaxa,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n2a, #leaving in case we want to change
'</br> Max Log Copies: ', round(n2_ymaxa, digits = 2),
'</br> Min Log Copies: ', round(n2_ymina, digits = 2),
'</br> Target: N2'),
name = "",
line = list(color = '#D95F02')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF A") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(n1_ymina), yend = ~max(n1_ymaxa),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(n1_ymina), yend = ~max(n1_ymaxa),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(n1_ymina), yend = ~max(n1_ymaxa),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(n1_ymina), yend = ~max(n1_ymaxa),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_sum_copies_L,
data = wrfa_smooth_n1,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_sum_copies_L, digits = 2)),
marker = list(color = '#1B9E77', size = 6, opacity = 0.65)) %>%
plotly::add_markers(x = ~date, y = ~log_sum_copies_L,
data = wrfa_smooth_n2,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_sum_copies_L, digits = 2)),
marker = list(color = '#D95F02', size = 6, opacity = 0.65))
p_wrf_a## Warning: `arrange_()` is deprecated as of dplyr 0.7.0.
## Please use `arrange()` instead.
## See vignette('programming') for more help
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.## Warning: `group_by_()` is deprecated as of dplyr 0.7.0.
## Please use `group_by()` instead.
## See vignette('programming') for more help
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.save(p_wrf_a, file = "./plotly_objs/p_wrf_a.rda")#**************************************WRF B PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#n1 extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_n1b <- ggplot(wrfb_smooth_n1, aes(x = date, y = log_sum_copies_L)) +
stat_smooth(aes(outfit=fit_n1b<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 142)## Warning: Ignoring unknown aesthetics: outfit#n2 extract
extract_n2b <- ggplot(wrfb_smooth_n2, aes(x = date, y = log_sum_copies_L)) +
stat_smooth(aes(outfit=fit_n2b<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 142)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#n1
extract_n1b## `geom_smooth()` using formula 'y ~ x'
fit_n1b## [1] 10.88831 10.98852 11.08647 11.18148 11.27284 11.35986 11.44185 11.51810
## [9] 11.58911 11.65599 11.71905 11.77857 11.83484 11.88816 11.93882 11.98541
## [17] 12.02661 12.06284 12.09451 12.12205 12.14588 12.16642 12.18410 12.19932
## [25] 12.21252 12.22411 12.23451 12.24415 12.25344 12.25402 12.24042 12.21737
## [33] 12.18963 12.16195 12.13908 12.12576 12.11010 12.07885 12.03473 11.98046
## [41] 11.91877 11.85238 11.78400 11.71635 11.65217 11.59416 11.54506 11.50758
## [49] 11.48443 11.47836 11.48464 11.49621 11.51222 11.53183 11.55418 11.57844
## [57] 11.60376 11.63653 11.68248 11.73973 11.80641 11.88064 11.96056 12.04429
## [65] 12.12996 12.21570 12.29963 12.37988 12.45459 12.52187 12.57986 12.63886
## [73] 12.70893 12.78781 12.87324 12.96295 13.05470 13.14622 13.23525 13.31954
## [81] 13.39682 13.46484 13.52133 13.56404 13.59072 13.60391 13.60869 13.60652
## [89] 13.59891 13.58732 13.57324 13.55815 13.53334 13.49093 13.43366 13.36425
## [97] 13.28546 13.20001 13.11065 13.02010 12.93112 12.84643 12.76878 12.70090
## [105] 12.64552 12.60540 12.56757 12.52056 12.46930 12.41871 12.37372 12.33926
## [113] 12.32025 12.31080 12.30203 12.29440 12.28839 12.28444 12.28302 12.28458
## [121] 12.28960 12.29853 12.31183 12.32997 12.35339 12.38258 12.41798 12.45758
## [129] 12.49953 12.54450 12.59318 12.64625 12.70440 12.76830 12.83793 12.91269
## [137] 12.99235 13.07670 13.16554 13.25864 13.35580 13.45681#n2
extract_n2b## `geom_smooth()` using formula 'y ~ x'
fit_n2b## [1] 10.55486 10.68774 10.81740 10.94341 11.06532 11.18272 11.29515 11.40218
## [9] 11.50417 11.60185 11.69535 11.78478 11.87026 11.95193 12.02991 12.10306
## [17] 12.17042 12.23234 12.28918 12.34130 12.38904 12.43277 12.47284 12.50960
## [25] 12.54341 12.57463 12.60361 12.63070 12.65626 12.67467 12.68215 12.68182
## [33] 12.67680 12.67023 12.66522 12.66489 12.65928 12.63800 12.60352 12.55831
## [41] 12.50485 12.44561 12.38308 12.31971 12.25800 12.20041 12.14942 12.10750
## [49] 12.07713 12.06078 12.04052 12.00219 11.95394 11.90393 11.86030 11.83121
## [57] 11.82482 11.84101 11.87282 11.91815 11.97487 12.04087 12.11404 12.19226
## [65] 12.27343 12.35541 12.43611 12.51341 12.58519 12.64934 12.70375 12.76152
## [73] 12.83508 12.92131 13.01710 13.11933 13.22487 13.33061 13.43342 13.53019
## [81] 13.61779 13.69311 13.75303 13.79442 13.81417 13.81411 13.80039 13.77634
## [89] 13.74531 13.71066 13.67572 13.64384 13.60338 13.54259 13.46466 13.37278
## [97] 13.27015 13.15996 13.04540 12.92967 12.81595 12.70745 12.60734 12.51884
## [105] 12.44512 12.38938 12.34657 12.30865 12.27435 12.24241 12.21157 12.18055
## [113] 12.14808 12.11497 12.08288 12.05190 12.02212 11.99361 11.96647 11.94077
## [121] 11.91660 11.89404 11.87317 11.85408 11.83686 11.82158 11.80832 11.79656
## [129] 11.78589 11.77659 11.76895 11.76327 11.75982 11.75891 11.76048 11.76426
## [137] 11.77014 11.77799 11.78771 11.79919 11.81232 11.82697#assign fits to a vector
n1_trendb <- fit_n1b
n2_trendb <- fit_n2b
#extract y min and max for each
limits_n1b <- ggplot_build(extract_n1b)$data## `geom_smooth()` using formula 'y ~ x'limits_n1b <- as.data.frame(limits_n1b)
n1_yminb <- limits_n1b$ymin
n1_ymaxb <- limits_n1b$ymax
limits_n2b <- ggplot_build(extract_n2b)$data## `geom_smooth()` using formula 'y ~ x'limits_n2b <- as.data.frame(limits_n2b)
n2_yminb <- limits_n2b$ymin
n2_ymaxb <- limits_n2b$ymax
#reassign dataframes (just to be safe)
work_n1b <- wrfb_smooth_n1
work_n2b<- wrfb_smooth_n1
#fill in missing dates to smooth fits
work_n1b <- work_n1b %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_n1b <- work_n1b$date
work_n2b <- work_n2b %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_n2b <- work_n2b$date
#create a new smooth dataframe to layer
smooth_frame_n1b <- data.frame(date_vec_n1b, n1_trendb, n1_yminb, n1_ymaxb)
smooth_frame_n2b <- data.frame(date_vec_n2b, n2_trendb, n2_yminb, n2_ymaxb)
#WRF B
#plot smooth frames
p_wrf_b <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_n1b, y = ~n1_trendb,
data = smooth_frame_n1b,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n1b,
'</br> Median Log Copies: ', round(n1_trendb, digits = 2),
'</br> Target: N1'),
line = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_lines(x = ~date_vec_n2b, y = ~n2_trendb,
data = smooth_frame_n2b,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n2b,
'</br> Median Log Copies: ', round(n2_trendb, digits = 2),
'</br> Target: N2'),
line = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
plotly::add_ribbons(x ~date_vec_n1b, ymin = ~n1_yminb, ymax = ~n1_ymaxb,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n1b, #leaving in case we want to change
'</br> Max Log Copies: ', round(n1_ymaxb, digits = 2),
'</br> Min Log Copies: ', round(n1_yminb, digits = 2),
'</br> Target: N1'),
name = "",
line = list(color = '#1B9E77')) %>%
plotly::add_ribbons(x ~date_vec_n2b, ymin = ~n2_yminb, ymax = ~n2_ymaxb,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n2b, #leaving in case we want to change
'</br> Max Log Copies: ', round(n2_ymaxb, digits = 2),
'</br> Min Log Copies: ', round(n2_yminb, digits = 2),
'</br> Target: N2'),
name = "",
line = list(color = '#D95F02')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF B") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(n1_yminb), yend = ~max(n1_ymaxb),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(n1_yminb), yend = ~max(n1_ymaxb),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(n1_yminb), yend = ~max(n1_ymaxb),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(n1_yminb), yend = ~max(n1_ymaxb),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_sum_copies_L,
data = wrfb_smooth_n1,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_sum_copies_L, digits = 2)),
marker = list(color = '#1B9E77', size = 6, opacity = 0.65)) %>%
plotly::add_markers(x = ~date, y = ~log_sum_copies_L,
data = wrfb_smooth_n2,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_sum_copies_L, digits = 2)),
marker = list(color = '#D95F02', size = 6, opacity = 0.65))
p_wrf_bsave(p_wrf_b, file = "./plotly_objs/p_wrf_b.rda")#**************************************WRF C PLOT********************************************** #add trendlines #extract data from geom_smooth #n1 extract # *********************************span 0.6*********************************** #*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_n1c <- ggplot(wrfc_smooth_n1, aes(x = date, y = log_sum_copies_L)) +
stat_smooth(aes(outfit=fit_n1c<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 128)## Warning: Ignoring unknown aesthetics: outfit#n2 extract
extract_n2c <- ggplot(wrfc_smooth_n2, aes(x = date, y = log_sum_copies_L)) +
stat_smooth(aes(outfit=fit_n2c<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 128)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#n1
extract_n1c## `geom_smooth()` using formula 'y ~ x'
fit_n1c## [1] 11.05907 11.13499 11.20864 11.27993 11.34873 11.41495 11.47846 11.53917
## [9] 11.59712 11.65249 11.70535 11.75576 11.80379 11.84951 11.89299 11.93429
## [17] 11.97350 12.01066 12.04586 12.07916 12.11063 12.14034 12.16708 12.18979
## [25] 12.20879 12.22438 12.23687 12.24657 12.25379 12.25883 12.26201 12.26362
## [33] 12.26399 12.26341 12.26219 12.26065 12.25657 12.24805 12.23586 12.22077
## [41] 12.20355 12.18497 12.16580 12.14681 12.12877 12.11244 12.09861 12.08803
## [49] 12.08148 12.07973 12.08837 12.10932 12.13784 12.16916 12.19855 12.22126
## [57] 12.23255 12.23606 12.23851 12.23978 12.23972 12.23819 12.23506 12.23018
## [65] 12.22342 12.21465 12.20371 12.19048 12.17482 12.15658 12.13564 12.11540
## [73] 12.09877 12.08483 12.07266 12.06134 12.04996 12.03760 12.02333 12.00624
## [81] 11.98541 11.95992 11.92885 11.89129 11.84632 11.77531 11.66927 11.54170
## [89] 11.40613 11.27606 11.16502 11.08651 11.02649 10.96285 10.89696 10.83020
## [97] 10.76397 10.69965 10.63861 10.58224 10.53193 10.48906 10.45501 10.43117
## [105] 10.41892 10.41964 10.43068 10.44828 10.47220 10.50221 10.53804 10.57948
## [113] 10.62626 10.67814 10.73488 10.79625 10.86198 10.93185 11.00560 11.08299
## [121] 11.16445 11.25054 11.34126 11.43663 11.53663 11.64127 11.75056 11.86448#n2
extract_n2c## `geom_smooth()` using formula 'y ~ x'
fit_n2c## [1] 11.53956 11.57288 11.60547 11.63682 11.66645 11.69386 11.71857 11.74007
## [9] 11.75825 11.77353 11.78622 11.79666 11.80515 11.81204 11.81762 11.82224
## [17] 11.82620 11.82983 11.83346 11.83740 11.84198 11.84751 11.84994 11.84569
## [25] 11.83581 11.82134 11.80334 11.78285 11.76091 11.73859 11.71691 11.69694
## [33] 11.67972 11.66629 11.65771 11.65502 11.65974 11.67209 11.69115 11.71598
## [41] 11.74568 11.77930 11.81594 11.85466 11.89455 11.93468 11.97412 12.01197
## [49] 12.04728 12.07915 12.13729 12.24066 12.37216 12.51469 12.65116 12.76446
## [57] 12.83751 12.88055 12.91540 12.94232 12.96157 12.97341 12.97811 12.97591
## [65] 12.96708 12.95189 12.93058 12.90343 12.87068 12.83261 12.78947 12.73740
## [73] 12.67363 12.60009 12.51871 12.43142 12.34015 12.24682 12.15336 12.06170
## [81] 11.97376 11.89147 11.81677 11.75157 11.69781 11.64662 11.58974 11.52997
## [89] 11.47014 11.41305 11.36152 11.31837 11.28530 11.26130 11.24508 11.23537
## [97] 11.23090 11.23038 11.23254 11.23610 11.23978 11.24230 11.24239 11.23878
## [105] 11.23017 11.21530 11.19751 11.18078 11.16474 11.14905 11.13334 11.11727
## [113] 11.10047 11.08260 11.06330 11.04222 11.01900 10.99328 10.96472 10.93296
## [121] 10.89867 10.86282 10.82541 10.78648 10.74607 10.70419 10.66088 10.61617#assign fits to a vector
n1_trendc <- fit_n1c
n2_trendc <- fit_n2c
#extract y min and max for each
limits_n1c <- ggplot_build(extract_n1c)$data## `geom_smooth()` using formula 'y ~ x'limits_n1c <- as.data.frame(limits_n1c)
n1_yminc <- limits_n1c$ymin
n1_ymaxc <- limits_n1c$ymax
limits_n2c <- ggplot_build(extract_n2c)$data## `geom_smooth()` using formula 'y ~ x'limits_n2c <- as.data.frame(limits_n2c)
n2_yminc <- limits_n2c$ymin
n2_ymaxc <- limits_n2c$ymax
#reassign dataframes (just to be safe)
work_n1c <- wrfc_smooth_n1
work_n2c <- wrfc_smooth_n1
#fill in missing dates to smooth fits
work_n1c <- work_n1c %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_n1c <- work_n1c$date
work_n2c <- work_n2c %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_n2c <- work_n2c$date
#create a new smooth dataframe to layer
smooth_frame_n1c <- data.frame(date_vec_n1c, n1_trendc, n1_yminc, n1_ymaxc)
smooth_frame_n2c <- data.frame(date_vec_n2c, n2_trendc, n2_yminc, n2_ymaxc)
#WRF C
#plot smooth frames
p_wrf_c <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_n1c, y = ~n1_trendc,
data = smooth_frame_n1c,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n1c,
'</br> Median Log Copies: ', round(n1_trendc, digits = 2),
'</br> Target: N1'),
line = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_lines(x = ~date_vec_n2c, y = ~n2_trendc,
data = smooth_frame_n2c,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n2c,
'</br> Median Log Copies: ', round(n2_trendc, digits = 2),
'</br> Target: N2'),
line = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
plotly::add_ribbons(x ~date_vec_n1c, ymin = ~n1_yminc, ymax = ~n1_ymaxc,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n1c, #leaving in case we want to change
'</br> Max Log Copies: ', round(n1_ymaxc, digits = 2),
'</br> Min Log Copies: ', round(n1_yminc, digits = 2),
'</br> Target: N1'),
name = "",
line = list(color = '#1B9E77')) %>%
plotly::add_ribbons(x ~date_vec_n2c, ymin = ~n2_yminc, ymax = ~n2_ymaxc,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n2c, #leaving in case we want to change
'</br> Max Log Copies: ', round(n2_ymaxc, digits = 2),
'</br> Min Log Copies: ', round(n2_yminc, digits = 2),
'</br> Target: N2'),
name = "",
line = list(color = '#D95F02')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF C") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(n1_yminc), yend = ~max(n1_ymaxc),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(n1_yminc), yend = ~max(n1_ymaxc),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(n1_yminc), yend = ~max(n1_ymaxc),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(n1_yminc), yend = ~max(n1_ymaxc),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_sum_copies_L,
data = wrfc_smooth_n1,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_sum_copies_L, digits = 2)),
marker = list(color = '#1B9E77', size = 6, opacity = 0.65)) %>%
plotly::add_markers(x = ~date, y = ~log_sum_copies_L,
data = wrfc_smooth_n2,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_sum_copies_L, digits = 2)),
marker = list(color = '#D95F02', size = 6, opacity = 0.65))
p_wrf_csave(p_wrf_c, file = "./plotly_objs/p_wrf_c.rda")save(smooth_frame_n1a, file = "./plotly_objs/smooth_frame_n1a.rda")
save(smooth_frame_n2a, file = "./plotly_objs/smooth_frame_n2a.rda")
save(smooth_frame_n1b, file = "./plotly_objs/smooth_frame_n1b.rda")
save(smooth_frame_n2b, file = "./plotly_objs/smooth_frame_n2b.rda")
save(smooth_frame_n1c, file = "./plotly_objs/smooth_frame_n1c.rda")
save(smooth_frame_n2c, file = "./plotly_objs/smooth_frame_n2c.rda")save(date_vec_n1a, file = "./plotly_objs/date_vec_n1a.rda")
save(date_vec_n2a, file = "./plotly_objs/date_vec_n2a.rda")
save(date_vec_n1b, file = "./plotly_objs/date_vec_n1b.rda")
save(date_vec_n2b, file = "./plotly_objs/date_vec_n2b.rda")
save(date_vec_n1c, file = "./plotly_objs/date_vec_n1c.rda")
save(date_vec_n2c, file = "./plotly_objs/date_vec_n2c.rda")save(n1_ymina, file = "./plotly_objs/n1_ymina.rda")
save(n1_ymaxa, file = "./plotly_objs/n1_ymaxa.rda")
save(n2_ymina, file = "./plotly_objs/n2_ymina.rda")
save(n2_ymaxa, file = "./plotly_objs/n2_ymaxa.rda")
save(n1_yminb, file = "./plotly_objs/n1_yminb.rda")
save(n1_ymaxb, file = "./plotly_objs/n1_ymaxb.rda")
save(n2_yminb, file = "./plotly_objs/n2_yminb.rda")
save(n2_ymaxb, file = "./plotly_objs/n2_ymaxb.rda")
save(n1_yminc, file = "./plotly_objs/n1_yminc.rda")
save(n1_ymaxc, file = "./plotly_objs/n1_ymaxc.rda")
save(n2_yminc, file = "./plotly_objs/n2_yminc.rda")
save(n2_ymaxc, file = "./plotly_objs/n2_ymaxc.rda")